perm filename M11A.F4[M11,LCS]5 blob
sn#418024 filedate 1979-02-14 generic text, type T, neo UTF8
C *** MUSIC V FOR PDP11, AS REVISED BY LELAND SMITH ***
C *********** LIMITS ******************
C 15 INST DEFINITIONS. 20 NOTES PLAYING AT ONCE. 27 DIFFERENT INS. NAMES.
INTEGER PEAK,CONV
CXX DOUBLE PRECISION JFLNM,JTRNS,JBLA
DIMENSION T(50),TI(50),ITI(50)
COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF /NDEV/NDEV
1 /CONV/CONV,INIOUT,JFLNM
1 /LFUNC/LFUNC,XNFUN,PINCR /IFIRST/IFIRST,IDT
1 /GENS/GENS(3072) /LOCG/LOCG(6)
DO 10 N1=1,NGENS
10 LOCG(N1)=(N1-1)*LFUNC+1
C ABOVE SETS UP 6 POSSIBLE FUNCS. NUMBER MAY BE INCREASED.
C TO INCREASE NUM. OF GENS AVAILABLE ENLARGE 'GENS' BY 512 PER GEN AND
C PUT PROPER NUMBER INTO 'NGENS' DATA AND 'LOCG' ARRAY SIZE.
C ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
DATA ISRT/10000/, LFUNC/512/, CONV/-1/,XNFUN/511.0/
1 ,NPAR/35/,NINS/27/,LBLK/512/,NGENS/6/,PFUNC/512.0/,NLIM/700/
C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
C NLIM=NPAR* HOW MANY NOTES CAN PLAY AT ONCE. (NPAR*20=700, RNT SIZE)
COMMON /INS/INS(300),IDEF(15) /NT/RNT(700) /ROUT/ROUT(3072)
C INS=(15)INSTRUMENT DEFINITIONS: EACH INST. CAN USE 15 TO 40+ SLOTS
C IDEF=LOCATION TABLE: 15 INST. DEFS. POSSIBLE AT ONE TIME.
C RNT=PARAM. LIST FOR CURRENTLY PLAYING NOTES. SIZE OF ARRAY SHOULD
C BE A MULTIPLE OF NPAR (35*20 CURRENTLY=20 NOTES CAN PLAY AT ONCE.)
C ***** ONLY 15 DIFFERENT INS NUMBERS CAN BE USED. (1-15) ********
C ROUT=OUTPUT BLOCK (B1→B6)(6*512)
EQUIVALENCE (I1,I),(I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3)),
1 (P4,P(4)),(I5,I(5)),(I6,I(6)),(I4,I(4)),(P2,P(2)),(I3,I(3))
DATA JTRNS/'TRNS '/,JBLA/' '/, NDEV/5/
C******** NDEV IS FOR 'TYPE' DEVICE NUMBER *********
NBUF=512
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
CZZ44 TYPE 401
CZZ ACCEPT 501,JFLNM,CONV
C TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
CC IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
CXX CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
CZZ CALL IFILE(21,JFLNM)
C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
401 FORMAT(' TYPE FILE NAME'/)
501 FORMAT(A5,5I)
1000 INIOUT=-1
C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
IFIRST=-1
IDT=1
C ABOVE 2 ARE IN TRANS. ROUTINES.
PEAK=0
RPEAK=0
C RPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
I2=1
IF(I4.EQ.0)I4=ISRT
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
MOUT=1
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=1,NLIM,NPAR
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 RNT(N1)=-1
DO 221 N1=1,NINS
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
IF(P(1).NE.1.AND.P(1).NE.6)GO TO 200
C JUMP IF A NOTE OR A FINISH
CC IF(P2-T(1))200,200,244
IF(P2.GT.T(1))GO TO 244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALL ERROR(1)
GO TO 204
CC 202 IF(NOPCD-IOP)201,203,203
202 IF(IOP.GT.12)GO TO 201
C ERROR IF OP CODE IS TOO BIG OR <0.
203 GO TO (1,2,3,4,5,6,7,8,201,201,11,11),IOP
11 IVAR=P3
IVARE=IVAR+I1-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
IF(N1.EQ.8)NBUF=512+512*I(N1)
C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
GO TO 204
3 IGEN=P3
CC IF(P4.GT.NGENS)CALL ERROR(4)
IF(P4.GT.NGENS)PAUSE ' FUNC. NUM. OUT RANGE'
C ERROR 4=FUNC NUMB. OUT OF RANGE.
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
7 IF(P4.LT.1)P4=1
C 'SEG' SEG F A,S A,S ... F=FUNC NUM. A=AMPL. S=STEP (1-100)
DO 430 K=4,I1,2
C CONVERT STEPS 1-100 TO 0-511.
430 P(K)=((P(K)-1.)/99.)*511.
530 DO 630 K=I1,1,-1
630 P(K+2)=P(K)
C ABOVE REFORMATS FOR 'GEN' ROUTINES.
P3=IOP-6
P2=0
I1=I1+2
GO TO 3
8 I1=I1+1
C 'SIN' SIN F AH, AH, ... F=FUNC NUM. AH=AMPL OF THAT HARMONIC.
P(I1)=I1-3
C GET TOTAL NUM. OF HARMONICS
GO TO 530
4 IVAR=P3
IVARE=IVAR+I1-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)
GO TO 204
6 CALL FROUT3(IDSK)
CCCC STOP
GO TO 1000
C ENTER NOTE TO BE PLAYED
1 DO 230 N1=1,NLIM,NPAR
230 IF(RNT(N1).EQ.-1)GO TO 231
CALL ERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
WRITE(NDEV,1230),NINS
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I1-1
M3=M2+1
M4=N1+NPAR-1
DO 232N1=M1,M2
M5=N1-M1+1
232 RNT(N1)=P(M5)
RNT(M1 )=P3
RNT(M1+3)=PINCR/P4
C CONVERTS 'P2' TO PROPER INCREMENT FOR DURATIONS.
IF(M3.GT.M4)GO TO 236
DO 233 N1=M3,M4
233 RNT(N1)=0
236 DO 235 N1=1,NINS
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P2+P4
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALL ERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I2
M2=IFIX(P3)
IF(M2.GT.15)PAUSE ' ***** INS NUMBER IS TOO HIGH.'
IDEF(M2)=M1
218 CALL DATA (NREAD)
CC IF(I1-2)210,210,211
IF(I1.GT.2)GO TO 211
210 INS(M1)=0
I2=M1+1
C END OF INST. DEF.
GO TO 204
211 INS(M1)=P3
C P3 IS UNIT GENERATOR CODE NUM.
CC M3=I(1)
INS(M1+1)=M1+I1-1
C I1 IS WDCNT OF LAST READIN
CC INS(MSTO)=M1+M3-1
M1=M1+2
CC DO 217N1=4,M3
DO 217N1=4,I1
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 INS(M1)=-1+(M5+101)*LFUNC
GO TO 216
301 INS(M1)=-1+(M5+1)*LBLK
GO TO 216
213 INS(M1)=M5
CC 213 IF(M5- 100 )214,214,215
CC 214 INS(M1)=M5
CC GO TO 216
CC 215 INS(M1)=M5+26262
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T2=P2
250 TMIN=90909.
IREST=1
DO 241N1=1,NINS
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T2)245,245,246
245 T3=TMIN
GO TO 260
246 T3=T2
GO TO 260
247 IF(T(1)-T2)249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
RNT(M2)=-1
GO TO 250
C SETUP REST
251 T3=T2
IREST=2
GO TO 260
C PLAY
260 ISAM=(T3-T(1))*FLOAT(I4)+.5
T(1)=T3
IF(ISAM)247,247,266
266 IF(ISAM-LBLK)262,262,263
262 I5=ISAM
ISAM=0
GO TO 264
263 I5=LBLK
ISAM=ISAM-LBLK
264 IF(I(8))290,290,291
290 M3=MOUT+I5-1
MSAMP=I5
GO TO 292
291 M3=MOUT+(2*I5)-1
MSAMP=2*I5
292 DO 267N1=MOUT,M3
267 ROUT(N1)=0
GO TO (268,265),IREST
268 DO 270 NS1=1,NLIM,NPAR
IF(RNT(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I3=NS1
IGEN=RNT(NS1)
IGEN=IDEF(IGEN)
272 I6=IGEN
294 CALL FORSAM
295 IGEN=INS(IGEN+1)
IF(INS(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
SUBROUTINE DATA (N)
COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK /IFIRST/IFIRST,IDT
1 /JP/JPRNT /NDEV/NDEV
CSS COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
EQUIVALENCE (K,I),(P2,P(2))
CALL TRANS(IDT)
CZZ READ (N) K,(P(J),J=1,K)
IF(JPRNT.LT.0)GO TO 3
C DON'T TYPE BEGIN TIMES IF INPUT IS BEING TYPED OUT. (JPRNT=-1)
IF(P(1).EQ.1)WRITE(NDEV,1),P2
3 IF(PEAK.LE.RPEAK)RETURN
CSS IF(JPEAK.LE.IPEAK)RETURN
WRITE(NDEV,2),PEAK
CSS TYPE 2,JPEAK
RPEAK=PEAK
CSS IPEAK=JPEAK
C TYPES OUT EACH NEW PEAK AMPL.
RETURN
1 FORMAT('+',F9.2,$)
2 FORMAT(' AMPL=',F5.0,$)
CSS2 FORMAT('+ AMPL=',I4,$)
END
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
COMMON /ROUT/ROUT(1) /FINOUT/PEAK /CONV/CONV /NDEV/NDEV
CC 1 /IFIRST/IFIRST,IDT
CC IFIRST=-1
CC IDT=0
C THE ABOVE ARE RESETS TO GET BACK TO 'INPUT?'
DO 1 K=1,512
1 ROUT(K)=0
CALL SAMOUT(IDSK,512)
WRITE(NDEV,10),PEAK
C NOW CLOSE OFF THE FILE
IF(CONV.NE.0)GO TO 3
END FILE 23
RETURN
C3 CALL FINFIL
3 CALL FINEXT
CC TYPE 2
CALL PLAY
RETURN
2 FORMAT(' TEST.SND WAS WRITTEN ********')
10 FORMAT (/' PEAK AMPL.=',F7.0)
END